home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 3
/
Cream of the Crop 3.iso
/
comm
/
prtcs155.zip
/
USERUL.WPL
< prev
next >
Wrap
Text File
|
1994-01-14
|
5KB
|
192 lines
/**/
v="$VER: UserUL Wplrx Get user upload descriptions Williamson 54.09"
/* Non-Secure Inbound directory */
/* Mail:Inbound/nonsecure/ */
indir=addslash(dequote(getclip('INDIR')))||'NONSECURE/'
/* TAGNAME of your SYSOP Feedback message base */
sysopbase=GetClip('SYSOPBASE')
/* Your name */
sysop=GetClip('SYSOP')
rpath=addslash(dequote(GetClip('REXXDIR')))
options RESULTS
options failat 99
signal on syntax
signal on halt
signal on ioerr
signal on break_c
signal on break_d
pragma("W","NULL")
/* Check if ROOFLOG port is available */
log=show('P','ROOFLOG')
sv = 'v'||right(v,5)
script = "UserUL"
mailer=GetCLip('SHELTER')
l_mailer=lower(mailer)
cr = '\r\n' /* WPL */
nl = '0a'X /* REXX */
bs = '08'x
quote = '"'
tmsg="T:User-"pragma('ID')
parse arg username
filefile='LOG:needdesc'
if upper(username)="USER" then username="Unknown User"
if ~exists(filefile) then exit
if ~open('rf',filefile,'r') then exit
do while ~eof('rf')
x=readln('rf')
if x="" then iterate
if words(x) ~= 2 then call PutLog("error:" x,10,10)
parse var x remfile localfile
desc=strip(wpl_prompt(200,cr||'Please describe 'remfile' (max: 79 characters)'||cr))
call PutLog('File:'localfile' Desc:'desc,10,10)
address COMMAND "FileNote" localfile '"'||desc||'"'
drop desc
x=upper(wpl_prompt(120,'Would you like to enter a long description? (y/N) '))
if x="Y" then call feedback
end
call close('rf')
call delete(filefile)
call send(cr||'Bye and Thanks for the uploads 'username||cr)
exit
/* feedback to sysop */
feedback:
call send(cr||' To: 'sysop)
call send(cr||' From: 'username)
call send(cr||' Subject: 'remfile)
call send(cr||' Enter your message one line at a time.'||cr)
call send(cr||' Hit CR to select Save or continue.'||cr)
call open('smsg',tmsg,"W")
call writech('smsg'," Long Description for "remfile" from "username" Posted:"date()" at "time()||nl)
editing=1
line=1
c=0
do while editing
do while resp ~= ""
'CheckCarrier'
if RC~=0 then leave
resp=wpl_prompt(200,"-->"line": ")
if resp ~= "" then do
chars=writech('smsg',resp||nl)
c=c+chars
line=line+1
end
end /* hit a blank line */
'CheckCarrier'
if RC~=0 then do
call writech('smsg','User' username 'dropped carrier during feedback'||nl)
call PutLog('User' username 'dropped carrier during feedback',10,10)
call save_msg
call cleanup
exit
end
resp=wpl_prompt(120,cr||' You entered 'line-1' lines and 'chars' characters (total:'c'), [S]ave/[c]ontinue?'||cr)
if upper(resp)="S" then editing=0
end /* finished editing */
call writech('smsg',nl)
call close('smsg')
call PutLog('Saving message from 'username' in 'sysopbase,10,10)
call send(cr||' Saving......')
if exists("RPDIR:SMSG") then do
cmd='RUN SMSG 'sysopbase tmsg '"'username'"' '"'sysop'"' remfile
address COMMAND cmd
end;else do
cmd=rpath'Smsg.rexx' sysopbase tmsg '"'username'"' '"'sysop'"' remfile
call PutLog('Executing:' cmd,10,10)
Address "AREXX" cmd
end
address
call send(cr||' Message saved, thanks' username||cr)
return 0
send:
'Print' quote||arg(1)||quote
'Send' quote||arg(1)||quote
return
wpl_prompt:
'Print' quote||arg(2)||quote
'Send' quote||arg(2)||quote
getstring:
'GetInbound E0 'arg(1)
'String $(event)'
if upper(RESULT) = 'CARRIER' then do
'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) UserUL $(remote.address) Lost Carrier"'
call PutLog('User 'username' dropped carrier',10,10)
call cleanup
exit
end;else if upper(RESULT) = 'LOGIN' then do
'String $(namebuf)'
x=(RESULT)
end;else x=""
return x
get_fn:
if LastPos('/', arg(1)) ~= 0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
else if LastPos(':', arg(1)) ~= 0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
else return arg(1)
lower:
return(bitor(arg(1),'20'x))
PutLog: procedure expose log script
if arg(2) > GetClip('LOGLEVEL') & ~log then return 0
address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
address
return 0
addslash:
curr = arg(1)
select
when right(curr, 1) = ":" then nop
when right(curr, 1) = "/" then nop /* TackOn */
otherwise curr = curr"/"
end
return curr
/* a useful procedure by Walt Sullivan */
dequote:
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~= "" then return unq_thing
return thing
cleanup:
return 0
break_c:
break_d:
PutLog('User abort',10,10)
call cleanup
exit 10
novalue:
call template_oops "Novalue" sigl
syntax:
call template_oops "Syntax(RC=" || RC || ")" sigl RC
failure:
call template_oops "Failure(RC=" || RC || ")" sigl
ioerr:
call template_oops "IOErr" sigl
halt:
call template_oops "Halt" sigl
template_oops:
parse arg what badline code
if code ~= "" then PutLog('ERR: Line 'badline what errortext(code),10,10)
else PutLog('ERR: Line' badline what,10,10)
call cleanup
exit(40)
/**/